home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / qbfaqr01.zip / DIR.BAS < prev    next >
BASIC Source File  |  1992-04-10  |  3KB  |  77 lines
  1. '*********************************************************
  2. '***DIRSUBS module demo  ShareWare by HuffWare (C) 1991***
  3. '***You may freely distribute these routines in your   ***
  4. '***own programs.  The programs DIR.BAS, DIRSUBS.BAS   ***
  5. '***and DIR.BI maybe posted in unmodified form on any  ***
  6. '***Bulletin Board System.  Use of these routines is at***
  7. '***users descretion and HuffWare assumes no liabilty  ***
  8. '*********************************************************
  9. '***For more Qbasic or Basic PDS (7.0,7.1+) routines   ***
  10. '***and general help contact the Huff & Puff BBS at    ***
  11. '***(602)-996-0033 24 hours 7 days/week.               ***
  12. '*********************************************************
  13.  
  14. '***If run in QBX (QB) use QBX /L (QB /L) for InterruptX support***
  15. '$INCLUDE: 'DIR.BI'  '***DirSubs header file***
  16.  
  17. DEFINT A-Z
  18.  
  19. DIM TDInfo(1 TO MaxFiles) AS TDTA
  20.  
  21. FormatDir$ = "\      \ \ \  ##########  \  \  \        \  \      \\\"
  22.  
  23. CLS
  24. DirPath$ = "C:\"  '***Change to directory to list***
  25. NumberOfFiles = ReadDir(DirPath$, "*.*") '***Load directory into TDInfo array***
  26. SortDir (NumberOfFiles)                  '***Sort directory***
  27.  
  28. '***Display directory on screen***
  29. CLS
  30. CurrentDrive = ASC(LEFT$(UCASE$(DirPath$) + CHR$(0), 1)) - 64
  31. IF CurrentDrive < 1 OR CurrentDrive > GetNumberOfDrives% THEN
  32.    CurrentDrive = GetCurrentDrive%
  33. END IF
  34. PRINT USING "Volume in Drive \\is \          \"; CHR$(CurrentDrive + 64); GetVolumeName$(DirPath$)
  35. PRINT "Directory of "; DirPath$
  36. PRINT
  37.  
  38. FOR I = 1 TO NumberOfFiles
  39.      IF TDInfo(I).D = True THEN  '***Directory entry***
  40.         PRINT USING "\      \ <DIR>"; TDInfo(I).FName
  41.      ELSE
  42.         Rash$ = "...."              '***Set attributes***
  43.         IF TDInfo(I).R = True THEN
  44.            MID$(Rash$, 1, 1) = "R"
  45.         END IF
  46.         IF TDInfo(I).A = True THEN
  47.            MID$(Rash$, 2, 1) = "A"
  48.         END IF
  49.         IF TDInfo(I).S = True THEN
  50.            MID$(Rash$, 3, 1) = "S"
  51.         END IF
  52.         IF TDInfo(I).H = True THEN
  53.            MID$(Rash$, 4, 1) = "H"
  54.         END IF
  55.         Period = INSTR(TDInfo(I).FName, ".")
  56.         IF Period <> 0 THEN
  57.            FileName$ = LEFT$(TDInfo(I).FName, Period - 1)
  58.            FileExt$ = MID$(TDInfo(I).FName, Period + 1, LEN(TDInfo(I).FName))
  59.         ELSE
  60.            FileName$ = TDInfo(I).FName
  61.            FileExt$ = ""
  62.         END IF
  63.         '***Convert from 24 hour format to 12 hour format***
  64.         Hour = VAL(MID$(TDInfo(I).Time, 1, 2))
  65.         IF Hour > 12 THEN
  66.            Hour = Hour - 12
  67.            AP$ = "pm"
  68.         ELSE
  69.            AP$ = "am"
  70.         END IF
  71.         MID$(TDInfo(I).Time, 1, 2) = RIGHT$("0" + LTRIM$(STR$(Hour)), 2)
  72.         PRINT USING FormatDir$; FileName$; FileExt$; TDInfo(I).Size; Rash$; TDInfo(I).Date; TDInfo(I).Time; AP$
  73.      END IF
  74. NEXT I
  75. PRINT USING "       #### File(s)  ###,###,### bytes free"; NumberOfFiles; FreeSpace(CurrentDrive)
  76.  
  77.